C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.
C*** UNKNOWN, ENDIT, ILLEGL, TOOMCH, PLTCMD, SLUR, NAMEXT

	COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
	1 /LIMIT/LIMIT,ITEM,L,I,M /DPY/GO,TOP,BOT
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C					   ↓↓↓↓↓ V IS FOR READIN ONLY
C%%%%%%%%
	COMMON /STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,POS
	1 /PTR/PWDS(350)
	1/PLTR/PLT,RHT,DIS,XDIS
	COMMON /XRN/ RN(3000),V(3000) /ALF/INP(72),ML /SSS/SSS(200)
	1 /SLR/SLURX(272) 
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
	DIS=1.24 
C 1.24 IS FACTOR FOR 8 1/2 X 11 PAGE.
CCC	CALL ERRSET(0)
C AVOID USELESS TYPEOUTS.
	CALL MPRFAI
	END    

C***** SOME TYPEOUT AND ACCEPT ROUTINES *******

	SUBROUTINE UNKNWN(JA)
	CALL TYPSTR('UNKNOWN CODE =')
	CALL TYPINT(JA)
	CALL TYPCRL
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
	END

	SUBROUTINE ENDIT(A,ITMS)
	COMMON/TTOP/JTOP,JBOT
	COMMON /OUTF/JJ,KOUT,KNT
C FIND REAL VERTICAL SIZE OF IMAGE.
	X=(JTOP-JBOT)/200.0
	CALL TYPFLT(X)
	CALL TYPSTR(' INCHES. ')
	X=X*2.54
	CALL TYPFLT(X)
	CALL TYPSTR(' CM.  ')
	CALL TYPINT(ITMS)
	CALL TYPSTR(' ITEMS.  FILE=')
	CALL TYPWRD(KOUT)
	CALL TYPSTR('.PLT   ')
	CALL TYPINT(KNT)
	CALL TYPSTR(' VECTORS.')
	CALL PLOT(0,0,99)
C  THE END OF THE DATA
	END

	SUBROUTINE ILLEGL(JA)
	CALL TYPSTR('ILLEGAL STAFF# ')
	CALL TYPINT(JA)
	CALL TYPCRL
	END

	SUBROUTINE TOOMCH(K)
	CALL TYPSTR('***** TOO MUCH DATA ***** ')
	CALL TYPINT(K)
	CALL TYPSTR('/3000')
	STOP
	END

CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD

	SUBROUTINE PLTCMD(NOSET)
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ,KOUT,KNT
	DIMENSION NMS(20),RMOV1(20),RMOV2(20)
C**** NO MORE THAN 20 FILES PER PAGE **** (COULD BE INCREASED)
	COMMON /DL/RSIZ,SAVER,NAME,EXT /ALF/INP(72),ML
	COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)  /INCR/INCR
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7)),(NMS(1),NM1)
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
	DATA FA1(1)/'(A1) '/,F78F(1)/'(78F)'/,EXT/'MS'/,RYY/'Y'/

	IF(I2.NE.'%')GO TO 1
	I2=0
C  I2=% FIRST TIME THROUGH  (WAS X, BEFORE 2/78)
	RXC=0
	RMOV1(1)=RYY
	NAME=0
14	KA=0
3	KA=KA+1
	IF(MLL.EQ.0)GO TO 15
	K=K-2
	MLL=MLL-1
	IF(MLL.NE.0)GO TO 31
	IF(MORE)GO TO 10
C ADD 100 TO RSPC TO READ IN NEW ALPHABETICAL SERIES OF FILES.
15	CALL TYPSTR('TYPE FILE NAME')
	CALL TYPINT(KA)
	CALL TYPSTR(' ')
C  TYPE FIRST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
	CALL NAMEXT(K,EXT,MLL,RSPC)
	MORE=-1
	IF(RSPC.LT.100)GO TO 30
	MORE=0
	RSPC=RSPC-100.
30	IF(KA.LT.21)GO TO 155
	CALL TYPSTR('****ONLY 20 FILES ACCEPTED****')
	GO TO 10
155	IF(K.NE.' ')GO TO 51
	IF(KA.NE.1)GO TO 10
C  DEFAULT NAME IS 'TMP    1'
	K='TMP'
	MLL=1
51	IF(K.EQ.'99')GO TO 140
	IF(KA.EQ.1)NM1=K
C  99=BACKUP
251	IF(MLL.GE.99)GO TO 151
	IF(MLL.EQ.0)GO TO 151
	K=K+2*(MLL-1)
C THIS CHANGES GIVEN NAME TO LAST OF SERIES.
C I.E. AAAAA 5  WILL GET AAAAE FIRST AND WORK BACKWARDS.
151	IF(K.NE.'NOSET')GO TO 31
	NOSET=-1
C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
	GO TO 15

31	IF(LOOKX(K,EXT))GO TO 56
C JUMP IF FILE FOUND
	CALL TYPSTR('FILE NOT FOUND')
	CALL TYPCRL
	GO TO 15
11	FORMAT(A5,I,F)
56	IF(MLL.LT.99)GO TO 560
	MLL=0 
561	K=K+2
C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
	MLL=MLL+1
	IF(LOOKX(K,EXT))GO TO 561
C  KEEPS GOING BACK IF FILES ARE FOUND
	K=K-2
	CALL TYPSTR('READING FILES --- ')
	CALL TYPWRD(NM1)
	CALL TYPCHR('.',1)
	CALL TYPWRD(EXT)
	CALL TYPCHR('THRU  ',6)
	CALL TYPWRD(K)
	CALL TYPCRL
560	NMS(KA)=K
	IF(MLL.EQ.0)GO TO 5
	R8=RYY
	IF(RSPC.NE.0)R8=RSPC
	GO TO 21
5	CALL TYPSTR('MOVE UP AT END? ')
	ACCEPT 11,R8
	IF(R8.EQ.'99')GO TO 15
	CALL LO2UP(R8)
	X=R8
	IF(R8.NE.RYY)R8=0
C  IRCAM FORTRAN GIVES ERROR IF 'REREAD F78F' HITS AN ALPHA.
	IF(X.GT.'Z')REREAD F78F,R8
C211	FORMAT(A1)
C255	ACCEPT 211,R8
C	CALL LO2UP(R8)
C	IF(R8.GT.'Z')REREAD F78F,R8
C	IF(R8.EQ.99.)GO TO 15
C	IF(R8.NE.RYY)R8=0
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'  ('NO', R8=0, IS DEFAULT ANSWER)
21	RMOV1(KA+1)=R8
	RMOV2(KA)=R8
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
22  	CALL TYPSTR('SIZE FACTOR? ')
	ACCEPT F78F,RSIZ,R9

C********  SET R9 TO 1 FOR FULL DENSITY FILLER ON SIZES OVER 1.9
C********   R9=SLICE INCREMENT FOR FILLER

	IF(RSIZ.EQ.99)GO TO 5
	IF(RSIZ.EQ.0)RSIZ=1.
	CALL TYPSTR('TYPE OUTPUT NAME - ')
	ACCEPT 11,JJ
	CALL LO2UP(JJ)
	IF(JJ.EQ.' ')JJ='PLT'
	IF(JJ.EQ.'*')JJ=NMS(KA-1)
C TYPE * TO USE 1ST INPUT NAME FOR OUTPUT NAME.
	KOUT=JJ
	CALL VARIAN
C THIS SETS UP VARIAN OUTPUT IN MPV.DMP, ELSE A DUMMY
	INCR=1
C FOR CALCMP STYLE FILLER TYPE NUM ≥10    (USUALLY 20)
C INCR=20  MEANS FILLER INCREMENT OF 2 ON THE CALCMP
	IF(R9.NE.0)INCR=R9
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.NE.KB)GO TO 13
	I2=-1
	RETURN
C  THE END OF THE DATA
13	NAME=NMS(KA+1)
	CALL TYPWRD(NAME)
	CALL TYPCHR('.',1)
	CALL TYPWRD(EXT)
	CALL TYPCRL
	RETURN
12	KA=KA+1
	NAME=0
	R8=0
	R2=RSIZ
	R3=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	R7=0
	R5=1
	R6=1
	IF(RMOV2(KA).NE.RYY)R7=RMOV2(KA)
	IF(RMOV1(KA).NE.0)R5=0
	IF(RMOV2(KA).NE.0)GO TO 77
	IF(R7.EQ.0)RETURN
77	R6=0
	END


	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON /ALF/INP,SLURY(72) /SSS/ SSS(200) /SLR/ SLURX(1)  
	REAL CENTR
	COMMON /PLTR/PLT,RHT,RDIS,XDIS
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
	1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8   C	DATA RZZ/2.8/

2	IF(J8.GE.7)CALL BRKSLR
C J8=7=SLUR WITH VERT. BRKTS.  =8=BRKT ON LEFT ONLY. =9=ON RIGHT ONLY.
	J10=1
	J4=0
	KQ=5 
	TWICE=-1
C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
	IF(PLT.GE.0)GO TO 21
	TWICE=0
	KQ=1
	RWID=.2
	IF(RHT.LT.2)GO TO 21
	TWICE=1
	RWID=.14
C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
	IF(RHT.LT.3)GO TO 21
	TWICE=2
C  IF SIZE IS GE.3 4 SLURS ARE DRAWN
	RWID=.1
21	RST7=RSTJ2*7.
	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
5	R=30
CC5	R=32
C AFTER DOTTED NOTE
	GO TO 8
CC6	R=18
6	R=22
C BETWEEN NOTES
8	RX=-0.75
CC8	RX=-1.3
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX*RXX+RTILT*RTILT)
	IF(J8.NE.-1)GO TO 10
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
CCCC	RQQ=RQQ*RSTFAC(J2)
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ*RSTJ2
CCCC	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
10	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	IF(RJ.GE.300)RJ=0
	R7=AMOD(R7,100.0)
	R=RDIS*RX*.4
	L=R
	L=L*2
C TO INSURE AN EVEN NUMBER OF VECTORS (ONLY 1/2 ARE COMPUTED IN SLOOP)
	IF(L.LT.60)L=60
	IF(L.GT.272)L=272
	IF(J11.EQ.0)GO TO 1
	R=R*2
	RZ=L-60
	J11=RZ * 10./212. +7.
	RXXX=.02
111	IF(R.GT.272)J11=J11-RXXX*(R-272)
 	IF(J11.LT.7)J11=7
11	IF(MOD(L/J11,2).NE.0)GO TO 1
C TO INSURE AN UNEVEN NUMBER OF SEGMENTS (SO THE LAST IS BLACK)
	J11=J11+1
	GO TO 11
CC	J11=R/7. 
CC	IF(J11.LT.7)J11=7
CC	IF(J11.GT.39)J11=39
CC	J11=RDIS*L/J11
C FOR DASHED SLURS  
C  L=NUMB OF SEGMENTS IN THE CURVE.

1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	CALL SLOOP

	IF(J4.NE.0)GO TO 83
87	CALL LINES(SLURX(J10),SLURY(J10),3)
	IF(J11.EQ.0)J4=-1
83	J5=KQ
	J6=J10
	J7=L
CCCC	IF(J11.NE.0)GO TO  122
	IF(J4)GO TO 22
	IF(J11.NE.0)GO TO 22
	J5=-1
	J6=L
	J7=J10
22	CALL SLRS
CC22	DO 88 K=J6,J7,J5
CC88	CALL LINES(SLURX(K),SLURY(K),2)
CC	GO TO 123

CC122	KD=2
CC	KT=0
CC	KA=1
C THIS WILL MAKE DASHED SLURS  J11 HAS DASH SIZE.
CC	DO 188 K=J6,J7,J5
CC	KT=KT+1
CC	IF(KT.LT.J11)GO TO 188
CC	KT=0
CC	KD=KD+KA
CC	KA=-KA
C  BLANK-DASH FLIP-FLOP
CC188	CALL LINES(SLURX(K),SLURY(K),KD)

123	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
	IF(TWICE)RETURN
	TWICE=TWICE-1
	IF(J8.GT.0)GO TO 182
	J4=-J4
	R7=R7+RWID
C  RWID=WIDTH OF SLUR -- SEE DATA
	GO TO 1
180	RW=R+R7*RST7
	TWICE=-1
	KQ=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	TWICE=2
	RZ=RTILT/(RX-R3)
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
	IF(R10.EQ.0)GO TO 87
C 1ST AND 2ND ENDING BRACKET.  P10=1 OR 2. YOU MUST SET OTHER PARAM.
C  ST P7=8  P8=1.  FOR 2ND ENDING USE P8=2
	R4=R4+R7-4.5
	R5=1. 
	RX=18.
	J3=R3+RX*RSTJ2
	R6=50003899.+R10*10000.
	RQQ=R
	RWW=RW
C R AND RW WIPED OUT IN ALPHA
1181	CALL ALPHA
C BE CAREFUL ABOUT ALPH MIGHT WIPE OUT!!
	J5=1
1184	SLURY(1)=RQQ
C DO THESE HERE BECAUSE THEY GET WIPED OUT IN ALPHA.
	SLURY(2)=RWW
	SLURY(3)=RWW
	SLURY(4)=RQQ
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C .875 IS SIZE OF NUM.   R7=1 MAKES ITALIC FONT
	R7=1.
	R8=0
	CALL MAKNUM(R9)
	END
C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY

	SUBROUTINE NAMEXT(NAME,EXT,NUM,SPC)
	DIMENSION FORM2(5),FORMT(5),NUMS(30)
	EQUIVALENCE (F1,FORMT(1)),(F2,FORMT(2)),(F3,FORMT(3)),
	1 (F4,FORMT(4)),(F5,FORMT(5))
	COMMON /ALF/INP(72)
	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
	1, FORM3/'I,F)'/
1	FORMAT(72A1)
	ACCEPT 1,INP
	DO 2 K=2,72
	IF(INP(K).EQ.' ')GO TO 3
2	IF(INP(K).EQ.'.')GO TO 4
3	F3=FORM3
	F4=' '
	F5=' '
5	F2=FORM2(K-1)
	REREAD FORMT,NAME,NUM,SPC
	GO TO 10
4	FORMT(3)=FORM2(1)
C  CATCHES DOT
	DO 7 N=K+1,72
7	IF(INP(N).EQ.' ')GO TO 8
8	F4=FORM2(N-K-1)
	F5=FORM3
	F2=FORM2(K-1)
	REREAD FORMT,NAME,K,EXT,NUM,SPC
	CALL LO2UP(EXT)
10	CALL LO2UP(NAME)
	END